1 TADPOLE and BSWiMS

1.0.1 Loading the libraries

library("FRESA.CAD")
library(survival)
library(readxl)
library(igraph)
op <- par(no.readonly = TRUE)
pander::panderOptions('digits', 3)
pander::panderOptions('table.split.table', 400)
pander::panderOptions('keep.trailing.zeros',TRUE)

1.1 The data set

TADPOLE_D1_D2 <- read.csv("./Data/TADPOLE/TADPOLE_D1_D2.csv")
TADPOLE_D1_D2_Dict <- read.csv("./Data/TADPOLE/TADPOLE_D1_D2_Dict.csv")
TADPOLE_D1_D2_Dict_LR <- as.data.frame(read_excel("./Data/TADPOLE/TADPOLE_D1_D2_Dict_LR.xlsx",sheet = "LeftRightFeatures"))


rownames(TADPOLE_D1_D2_Dict) <- TADPOLE_D1_D2_Dict$FLDNAME

1.2 Conditioning the data


# mm3 to mm
isVolume <- c("Ventricles","Hippocampus","WholeBrain","Entorhinal","Fusiform","MidTemp","ICV",
              TADPOLE_D1_D2_Dict$FLDNAME[str_detect(TADPOLE_D1_D2_Dict$TEXT,"Volume")]
              )


#TADPOLE_D1_D2[,isVolume] <- apply(TADPOLE_D1_D2[,isVolume],2,'^',(1/3))
TADPOLE_D1_D2[,isVolume] <- TADPOLE_D1_D2[,isVolume]^(1/3)

# mm2 to mm
isArea <- TADPOLE_D1_D2_Dict$FLDNAME[str_detect(TADPOLE_D1_D2_Dict$TEXT,"Area")]
TADPOLE_D1_D2[,isArea] <- sqrt(TADPOLE_D1_D2[,isArea])

# Get only cross sectional measurements
FreeSurfersetCross <- str_detect(colnames(TADPOLE_D1_D2),"UCSFFSX")

# The subset of baseline measurements
baselineTadpole <- subset(TADPOLE_D1_D2,VISCODE=="bl")
table(baselineTadpole$DX)
                   Dementia Dementia to MCI             MCI MCI to Dementia 
          7             336               1             864               5 
  MCI to NL              NL       NL to MCI 
          2             521               1 

rownames(baselineTadpole) <- baselineTadpole$PTID


validBaselineTadpole <- cbind(DX=baselineTadpole$DX,
                                 AGE=baselineTadpole$AGE,
                                 Gender=1*(baselineTadpole$PTGENDER=="Female"),
                                 ADAS11=baselineTadpole$ADAS11,
                                 ADAS13=baselineTadpole$ADAS13,
                                 MMSE=baselineTadpole$MMSE,
                                 RAVLT_immediate=baselineTadpole$RAVLT_immediate,
                                 RAVLT_learning=baselineTadpole$RAVLT_learning,
                                 RAVLT_forgetting=baselineTadpole$RAVLT_forgetting,
                                 RAVLT_perc_forgetting=baselineTadpole$RAVLT_perc_forgetting,
                                 FAQ=baselineTadpole$FAQ,
                                 APOE4=1*(as.numeric(baselineTadpole$APOE4)>0),
                                 Ventricles=baselineTadpole$Ventricles,
                                 Hippocampus=baselineTadpole$Hippocampus,
                                 WholeBrain=baselineTadpole$WholeBrain,
                                 Entorhinal=baselineTadpole$Entorhinal,
                                 Fusiform=baselineTadpole$Fusiform,
                                 MidTemp=baselineTadpole$MidTemp,
                                 ICV=baselineTadpole$ICV,
                                 ABETA=as.numeric(baselineTadpole$ABETA_UPENNBIOMK9_04_19_17),
                                 TAU=as.numeric(baselineTadpole$TAU_UPENNBIOMK9_04_19_17),
                                 PTAU=as.numeric(baselineTadpole$PTAU_UPENNBIOMK9_04_19_17),
                                 baselineTadpole[,FreeSurfersetCross])

pander::pander(summary(validBaselineTadpole$APOE4))
Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
0 0 0 0.469 1 1 12 
pander::pander(summary(validBaselineTadpole$ABETA))
Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
203 596 854 1053 1396 3592 523 
pander::pander(summary(validBaselineTadpole$TAU))
Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
81.5 194 258 287 350 852 527 
pander::pander(summary(validBaselineTadpole$PTAU))
Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
8.21 17.4 24.2 27.6 34 103 528 

LeftFields <- TADPOLE_D1_D2_Dict_LR$LFN
names(LeftFields) <- LeftFields
LeftFields <- LeftFields[LeftFields %in% colnames(validBaselineTadpole)]
RightFields <- TADPOLE_D1_D2_Dict_LR$RFN
names(RightFields) <- RightFields
RightFields <- RightFields[RightFields %in% colnames(validBaselineTadpole)]

## Normalize to ICV
validBaselineTadpole$Ventricles=validBaselineTadpole$Ventricles/validBaselineTadpole$ICV
validBaselineTadpole$Hippocampus=validBaselineTadpole$Hippocampus/validBaselineTadpole$ICV
validBaselineTadpole$WholeBrain=validBaselineTadpole$WholeBrain/validBaselineTadpole$ICV
validBaselineTadpole$Entorhinal=validBaselineTadpole$Entorhinal/validBaselineTadpole$ICV
validBaselineTadpole$Fusiform=validBaselineTadpole$Fusiform/validBaselineTadpole$ICV
validBaselineTadpole$MidTemp=validBaselineTadpole$MidTemp/validBaselineTadpole$ICV

leftData <- validBaselineTadpole[,LeftFields]/validBaselineTadpole$ICV
RightData <- validBaselineTadpole[,RightFields]/validBaselineTadpole$ICV

## get mean and relative difference 
meanLeftRight <- (leftData + RightData)/2
difLeftRight <- abs(leftData - RightData)
reldifLeftRight <- difLeftRight/meanLeftRight
colnames(meanLeftRight) <- paste("M",colnames(meanLeftRight),sep="_")
colnames(difLeftRight) <- paste("D",colnames(difLeftRight),sep="_")
colnames(reldifLeftRight) <- paste("RD",colnames(reldifLeftRight),sep="_")


validBaselineTadpole <- validBaselineTadpole[,!(colnames(validBaselineTadpole) %in% 
                                               c(LeftFields,RightFields))]
validBaselineTadpole <- cbind(validBaselineTadpole,meanLeftRight,reldifLeftRight)

## Remove columns with too many NA more than %35 of NA
nacount <- apply(is.na(validBaselineTadpole),2,sum)/nrow(validBaselineTadpole) < 0.35
diagnose <- validBaselineTadpole$DX
pander::pander(table(diagnose))
  Dementia Dementia to MCI MCI MCI to Dementia MCI to NL NL NL to MCI
7 336 1 864 5 2 521 1 
validBaselineTadpole <- validBaselineTadpole[,nacount]
## Remove character columns
ischar <- sapply(validBaselineTadpole,class) == "character"
validBaselineTadpole <- validBaselineTadpole[,!ischar]
## Place back diagnose
validBaselineTadpole$DX <- diagnose

pander::pander(summary(validBaselineTadpole$APOE4))
Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
0 0 0 0.469 1 1 12 
pander::pander(summary(validBaselineTadpole$ABETA))
Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
203 596 854 1053 1396 3592 523 
pander::pander(summary(validBaselineTadpole$TAU))
Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
81.5 194 258 287 350 852 527 
pander::pander(summary(validBaselineTadpole$PTAU))
Min. 1st Qu. Median Mean 3rd Qu. Max. NA’s
8.21 17.4 24.2 27.6 34 103 528 


validBaselineTadpole <- validBaselineTadpole[complete.cases(validBaselineTadpole),]
ischar <- sapply(validBaselineTadpole,class) == "character"
validBaselineTadpole[,!ischar] <- sapply(validBaselineTadpole[,!ischar],as.numeric)

pander::pander(summary(validBaselineTadpole$APOE4))
Min. 1st Qu. Median Mean 3rd Qu. Max.
0 0 0 0.454 1 1 
pander::pander(summary(validBaselineTadpole$ABETA))
Min. 1st Qu. Median Mean 3rd Qu. Max.
203 623 874 1078 1427 3592 
pander::pander(summary(validBaselineTadpole$TAU))
Min. 1st Qu. Median Mean 3rd Qu. Max.
97.9 191 255 284 349 852 
pander::pander(summary(validBaselineTadpole$PTAU))
Min. 1st Qu. Median Mean 3rd Qu. Max.
8.21 17.1 23.8 27.3 33.9 103 

colnames(validBaselineTadpole) <- str_remove_all(colnames(validBaselineTadpole),"_UCSFFSX_11_02_15_UCSFFSX51_08_01_16")
colnames(validBaselineTadpole) <- str_replace_all(colnames(validBaselineTadpole)," ","_")
validBaselineTadpole$LONISID <- NULL
validBaselineTadpole$IMAGEUID <- NULL
validBaselineTadpole$LONIUID <- NULL

diagnose <- as.character(validBaselineTadpole$DX)
validBaselineTadpole$DX <- diagnose
pander::pander(table(validBaselineTadpole$DX))
Dementia Dementia to MCI MCI MCI to NL NL NL to MCI
154 1 478 1 302 1 


validDX <- c("NL","MCI","Dementia")

validBaselineTadpole <- validBaselineTadpole[validBaselineTadpole$DX %in% validDX,]
validBaselineTadpole$DX <- as.factor(validBaselineTadpole$DX)
pander::pander(table(validBaselineTadpole$DX))
Dementia MCI NL
154 478 302

1.2.1 Correlation Matrix Data

The heat map of the testing set.


cormat <- cor(validBaselineTadpole[,colnames(validBaselineTadpole) != "DX"],method="spearman")
diag(cormat) <- 0;
corrmax <- apply(cormat,2,max)
whomax <- colnames(cormat)[corrmax>0.75]
gplots::heatmap.2(abs(cormat[whomax,whomax]),
                  trace = "none",
                  scale = "none",
                  mar = c(10,10),
                  col=rev(heat.colors(5)),
                  main = "Baseline TADPOLE Correlation",
                  cexRow = 0.5,
                  cexCol = 0.5,
                  key.title=NA,
                  key.xlab="Spearman Correlation",
                  xlab="Feature", ylab="Feature")

par(op)

1.3 Get the Time To Event on MCI Subjects


subjectsID <- rownames(validBaselineTadpole)
visitsID <- unique(TADPOLE_D1_D2$VISCODE)
baseDx <- TADPOLE_D1_D2[TADPOLE_D1_D2$VISCODE=="bl",c("PTID","DX","EXAMDATE")]
rownames(baseDx) <- baseDx$PTID 
baseDx <- baseDx[subjectsID,]
lastDx <- baseDx
toDementia <- baseDx
table(lastDx$DX)

Dementia MCI NL 154 478 302

hasDementia <- lastDx$PTID[str_detect(lastDx$DX,"Dementia")]


for (vid in visitsID)
{
  DxValue <- TADPOLE_D1_D2[TADPOLE_D1_D2$VISCODE==vid,c("PTID","DX","EXAMDATE")]
  rownames(DxValue) <- DxValue$PTID 
  DxValue <- DxValue[DxValue$PTID %in% subjectsID,]
  noDX <- DxValue$PTID[nchar(DxValue$DX) < 1]
  print(length(noDX))
  DxValue[noDX,] <- lastDx[noDX,]
  inLast <- lastDx$PTID[lastDx$PTID %in% DxValue$PTID]
  print(length(inLast))
  lastDx[inLast,] <- DxValue[inLast,]
  noDementia <- !(toDementia$PTID %in% hasDementia)
  toDementia[noDementia,] <- lastDx[noDementia,]
  hasDementia <- unique(c(hasDementia,lastDx$PTID[str_detect(lastDx$DX,"Dementia")]))
}

[1] 0 [1] 934 [1] 2 [1] 889 [1] 5 [1] 818 [1] 19 [1] 741 [1] 573 [1] 695 [1] 23 [1] 465 [1] 10 [1] 106 [1] 8 [1] 81 [1] 26 [1] 389 [1] 20 [1] 178 [1] 9 [1] 64 [1] 556 [1] 556 [1] 56 [1] 56 [1] 87 [1] 87 [1] 87 [1] 87 [1] 389 [1] 389 [1] 143 [1] 143 [1] 77 [1] 77 [1] 4 [1] 4 [1] 7 [1] 47 [1] 6 [1] 34 [1] 0 [1] 0

table(lastDx$DX)
   Dementia Dementia to MCI             MCI MCI to Dementia       MCI to NL 
        273               2             315              46               6 
         NL       NL to MCI 
        275              17 
baseMCI <-baseDx$PTID[baseDx$DX == "MCI"]
lastDementia <- lastDx$PTID[str_detect(lastDx$DX,"Dementia")]
lastDementia2 <- toDementia$PTID[str_detect(toDementia$DX,"Dementia")]
lastNL <- lastDx$PTID[str_detect(lastDx$DX,"NL")]

MCIatBaseline <- baseDx[baseMCI,]
MCIatEvent <- toDementia[baseMCI,]
MCIatLast <- lastDx[baseMCI,]

MCIconverters <- MCIatBaseline[baseMCI %in% lastDementia,]
MCI_No_converters <- MCIatBaseline[!(baseMCI %in% MCIconverters$PTID),]
MCIconverters$TimeToEvent <- (as.Date(toDementia[MCIconverters$PTID,"EXAMDATE"]) 
                                   - as.Date(MCIconverters$EXAMDATE))

sum(MCIconverters$TimeToEvent ==0)

[1] 0



MCIconverters$AtEventDX <- MCIatEvent[MCIconverters$PTID,"DX"]
MCIconverters$LastDX <- MCIatLast[MCIconverters$PTID,"DX"]

MCI_No_converters$TimeToEvent <- (as.Date(lastDx[MCI_No_converters$PTID,"EXAMDATE"]) 
                                   - as.Date(MCI_No_converters$EXAMDATE))

MCI_No_converters$LastDX <- MCIatLast[MCI_No_converters$PTID,"DX"]

MCI_No_converters <- subset(MCI_No_converters,TimeToEvent > 0)

2 Prognosis MCI to AD Conversion

2.1 the set

TrainFraction <- 0.60;

MCIPrognosisIDs <- c(MCIconverters$PTID,MCI_No_converters$PTID)

TADPOLECrossMRI <- validBaselineTadpole[MCIPrognosisIDs,]
table(TADPOLECrossMRI$DX)

Dementia MCI NL 0 461 0

TADPOLECrossMRI$DX <- NULL
TADPOLECrossMRI$status <- 1*(rownames(TADPOLECrossMRI) %in% MCIconverters$PTID)
table(TADPOLECrossMRI$status)

0 1 307 154

TADPOLECrossMRI$TimeToEvent <- numeric(nrow(TADPOLECrossMRI))
TADPOLECrossMRI[MCIconverters$PTID,"TimeToEvent"] <- MCIconverters$TimeToEvent
TADPOLECrossMRI[MCI_No_converters$PTID,"TimeToEvent"] <- MCI_No_converters$TimeToEvent

TADPOLE_Cases <- subset(TADPOLECrossMRI,status==1)
TADPOLE_Controls <- subset(TADPOLECrossMRI,status==0)
trainCasesSet <- sample(nrow(TADPOLE_Cases),nrow(TADPOLE_Cases)*TrainFraction)
trainControlSet <- sample(nrow(TADPOLE_Controls),nrow(TADPOLE_Controls)*TrainFraction)

TADPOLE_Conv_TRAIN <- rbind(TADPOLE_Cases[trainCasesSet,],TADPOLE_Controls[trainControlSet,])
TADPOLE_Conv_TEST <- TADPOLECrossMRI[!(rownames(TADPOLECrossMRI) %in%
                                         rownames(TADPOLE_Conv_TRAIN)),]

pander::pander(table(TADPOLE_Conv_TRAIN$status))
0 1
184 92 
pander::pander(table(TADPOLE_Conv_TEST$status))
0 1
123 62 
par(op)

2.1.1 Learning


bConvml <- BSWiMS.model(Surv(TimeToEvent,status)~1,TADPOLE_Conv_TRAIN,NumberofRepeats = 20)

[+++++-+++++–++++++-+++++-+++++-++++-++++-++++-+++++-++++-++++-++++-+++-++++-++++–+++++-++++–+++++-+++++-++++-]…………….

pander::pander(bConvml$bagging$Jaccard.SM)

0.12


fs <- bConvml$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bConvml)
pander::pander(sm$coefficients)
  Estimate lower HR upper u.Accuracy r.Accuracy full.Accuracy u.AUC r.AUC full.AUC IDI NRI z.IDI z.NRI Delta.AUC Frequency
RAVLT_immediate -2.23e-02 9.78e-01 9.78e-01 9.78e-01 0.659 0.708 0.741 0.696 0.750 0.784 0.1027 0.836 6.29 7.76 0.034439 1.00
TAU 1.78e-03 1.00e+00 1.00e+00 1.00e+00 0.685 0.696 0.726 0.674 0.724 0.755 0.0781 0.617 5.11 5.08 0.030564 0.85
ADAS13 8.60e-03 1.01e+00 1.01e+00 1.01e+00 0.707 0.699 0.736 0.720 0.726 0.750 0.0891 0.630 4.89 5.24 0.024457 1.00
RD_ST47TA -1.02e+00 3.61e-01 3.61e-01 3.61e-01 0.507 0.739 0.746 0.541 0.774 0.780 0.0272 0.457 4.58 3.88 0.005435 0.25
M_ST39SA -1.57e+00 2.07e-01 2.07e-01 2.07e-01 0.674 0.710 0.750 0.668 0.758 0.796 0.0272 0.620 4.49 5.09 0.038043 0.25
ADAS11 3.74e-02 1.04e+00 1.04e+00 1.04e+00 0.692 0.757 0.763 0.698 0.782 0.785 0.0536 0.511 4.40 4.14 0.003458 1.00
M_ST40CV -3.39e+00 3.36e-02 3.36e-02 3.36e-02 0.645 0.717 0.717 0.655 0.736 0.745 0.0437 0.533 4.33 4.38 0.008152 0.05
ABETA -2.84e-04 1.00e+00 1.00e+00 1.00e+00 0.638 0.739 0.741 0.701 0.775 0.784 0.0502 0.724 4.32 7.05 0.009811 1.00
M_ST12SV -1.37e+01 1.08e-06 1.08e-06 1.08e-06 0.670 0.676 0.711 0.679 0.700 0.737 0.0313 0.518 4.31 4.27 0.036408 0.75
FAQ 5.98e-02 1.06e+00 1.06e+00 1.06e+00 0.688 0.736 0.752 0.658 0.769 0.786 0.0502 0.606 4.31 5.00 0.017355 1.00
M_ST30SV 6.91e+00 1.00e+03 1.00e+03 1.00e+03 0.609 0.703 0.703 0.620 0.736 0.728 0.0629 0.609 4.21 5.10 -0.008152 0.20
M_ST11SV -2.99e-10 1.00e+00 1.00e+00 1.00e+00 0.580 0.714 0.699 0.590 0.731 0.720 0.0496 0.380 4.04 3.07 -0.010870 0.05
M_ST58CV -7.26e+00 7.05e-04 7.05e-04 7.05e-04 0.670 0.764 0.764 0.685 0.788 0.788 0.0235 0.391 4.03 3.14 0.000000 0.05
M_ST56CV -7.12e+00 8.08e-04 8.08e-04 8.08e-04 0.638 0.721 0.746 0.644 0.755 0.780 0.0279 0.304 3.94 2.43 0.024457 0.80
Entorhinal -4.39e+00 1.24e-02 1.24e-02 1.24e-02 0.645 0.674 0.717 0.649 0.712 0.745 0.0471 0.500 3.74 4.08 0.032609 0.90
APOE4 4.07e-01 1.50e+00 1.50e+00 1.50e+00 0.638 0.745 0.750 0.649 0.772 0.776 0.0404 0.589 3.70 4.88 0.004041 1.00
RD_ST59TS -1.88e-01 8.28e-01 8.28e-01 8.28e-01 0.533 0.721 0.717 0.571 0.747 0.745 0.0156 0.326 3.66 2.72 -0.002717 0.15
RD_ST44TS -1.53e+00 2.16e-01 2.16e-01 2.16e-01 0.518 0.746 0.751 0.549 0.772 0.779 0.0255 0.423 3.60 3.56 0.007418 0.50
M_ST29SV -1.19e+01 6.99e-06 6.99e-06 6.99e-06 0.656 0.743 0.746 0.679 0.777 0.780 0.0414 0.522 3.56 4.27 0.002717 0.75
M_ST56SA -4.59e+00 1.02e-02 1.02e-02 1.02e-02 0.598 0.748 0.758 0.606 0.768 0.780 0.0294 0.377 3.46 3.03 0.011025 1.00
RAVLT_perc_forgetting 6.87e-04 1.00e+00 1.00e+00 1.00e+00 0.652 0.751 0.764 0.674 0.770 0.784 0.0264 0.546 3.45 4.53 0.014608 1.00
PTAU 6.38e-04 1.00e+00 1.00e+00 1.00e+00 0.707 0.750 0.754 0.690 0.772 0.769 0.0213 0.446 3.45 3.58 -0.002717 0.95
M_ST40SA -1.32e-10 1.00e+00 1.00e+00 1.00e+00 0.638 0.694 0.712 0.644 0.731 0.749 0.0246 0.522 3.43 4.25 0.018003 0.80
MMSE -6.19e-02 9.40e-01 9.40e-01 9.40e-01 0.692 0.763 0.763 0.660 0.786 0.785 0.0279 0.514 3.39 4.15 -0.000989 0.80
RD_ST34SA -3.12e+00 4.43e-02 4.43e-02 4.43e-02 0.511 0.714 0.723 0.535 0.750 0.752 0.0316 0.360 3.39 2.93 0.002070 0.20
RD_ST34CV -1.47e+00 2.31e-01 2.31e-01 2.31e-01 0.504 0.710 0.750 0.522 0.761 0.796 0.0301 0.511 3.34 4.31 0.035326 0.15
RD_ST49CV -3.97e-01 6.72e-01 6.72e-01 6.72e-01 0.536 0.761 0.754 0.573 0.777 0.769 0.0213 0.500 3.34 4.22 -0.008152 0.10
M_ST15SA -7.90e-12 1.00e+00 1.00e+00 1.00e+00 0.533 0.725 0.725 0.533 0.753 0.761 0.0261 0.446 3.30 3.59 0.008152 0.05
RD_ST26TA 1.48e+00 4.38e+00 4.38e+00 4.38e+00 0.601 0.754 0.750 0.576 0.769 0.766 0.0301 0.272 3.14 2.19 -0.002830 1.00
Hippocampus -2.31e+00 9.95e-02 9.95e-02 9.95e-02 0.652 0.707 0.717 0.674 0.726 0.745 0.0216 0.228 3.12 1.80 0.019022 0.20
M_ST60CV 4.05e+00 5.76e+01 5.76e+01 5.76e+01 0.554 0.699 0.717 0.552 0.720 0.745 0.0304 0.380 3.12 3.04 0.024457 0.05
RD_ST46SA -9.12e-01 4.02e-01 4.02e-01 4.02e-01 0.558 0.721 0.746 0.579 0.755 0.780 0.0230 0.457 3.08 3.80 0.024457 0.35
RD_ST24SA 3.86e-01 1.47e+00 1.47e+00 1.47e+00 0.576 0.707 0.703 0.557 0.731 0.728 0.0116 0.359 3.06 2.85 -0.002717 0.10
M_ST58SA -2.42e-11 1.00e+00 1.00e+00 1.00e+00 0.565 0.729 0.743 0.557 0.757 0.764 0.0194 0.210 3.03 1.66 0.006341 0.15
RD_ST55TS -2.69e+00 6.82e-02 6.82e-02 6.82e-02 0.500 0.710 0.726 0.533 0.735 0.755 0.0214 0.256 3.03 2.09 0.019866 0.60
M_ST49SA -6.71e-12 1.00e+00 1.00e+00 1.00e+00 0.547 0.707 0.707 0.560 0.731 0.734 0.0204 0.217 3.02 1.72 0.002717 0.05
M_ST24SA -2.72e-11 1.00e+00 1.00e+00 1.00e+00 0.580 0.723 0.736 0.598 0.750 0.764 0.0235 0.386 3.01 3.12 0.013587 0.10
RD_ST49TS -3.45e-12 1.00e+00 1.00e+00 1.00e+00 0.489 0.674 0.688 0.527 0.696 0.715 0.0263 0.261 2.99 2.18 0.019022 0.05
RD_ST56TA 1.18e-11 1.00e+00 1.00e+00 1.00e+00 0.591 0.707 0.721 0.573 0.723 0.739 0.0337 0.315 2.98 2.50 0.016304 0.05
RD_ST49SA -3.57e-01 7.00e-01 7.00e-01 7.00e-01 0.507 0.742 0.764 0.535 0.763 0.784 0.0110 0.300 2.85 2.46 0.021404 0.45
M_ST24CV -1.28e+01 2.65e-06 2.65e-06 2.65e-06 0.649 0.724 0.736 0.652 0.759 0.765 0.0272 0.408 2.84 3.26 0.005356 0.95
M_ST43TS 2.57e+01 1.39e+11 1.39e+11 1.39e+11 0.543 0.710 0.717 0.546 0.736 0.745 0.0153 0.174 2.61 1.37 0.008152 0.05 
pander::pander(bConvml$univariate[bConvml$selectedfeatures,])
  Name RName ZUni
ADAS11 ADAS11 ADAS11 8.40
ADAS13 ADAS13 ADAS13 8.89
ABETA ABETA ABETA 8.12
RAVLT_immediate RAVLT_immediate RAVLT_immediate 8.01
RAVLT_perc_forgetting RAVLT_perc_forgetting RAVLT_perc_forgetting 6.42
APOE4 APOE4 APOE4 4.94
RD_ST26TA RD_ST26TA RD_ST26TA 3.58
M_ST56SA M_ST56SA M_ST56SA 5.03
FAQ FAQ FAQ 5.17
PTAU PTAU PTAU 5.60
M_ST24CV M_ST24CV M_ST24CV 6.26
Entorhinal Entorhinal Entorhinal 6.01
TAU TAU TAU 5.45
M_ST56CV M_ST56CV M_ST56CV 6.04
MMSE MMSE MMSE 5.41
M_ST40SA M_ST40SA M_ST40SA 5.63
M_ST29SV M_ST29SV M_ST29SV 6.74
M_ST12SV M_ST12SV M_ST12SV 6.73
RD_ST55TS RD_ST55TS RD_ST55TS 2.52
RD_ST44TS RD_ST44TS RD_ST44TS 2.30
RD_ST49SA RD_ST49SA RD_ST49SA 2.21
RD_ST46SA RD_ST46SA RD_ST46SA 2.73
M_ST39SA M_ST39SA M_ST39SA 5.69
RD_ST47TA RD_ST47TA RD_ST47TA 1.58
Hippocampus Hippocampus Hippocampus 6.59
M_ST30SV M_ST30SV M_ST30SV 5.13
RD_ST34SA RD_ST34SA RD_ST34SA 2.11
M_ST58SA M_ST58SA M_ST58SA 3.99
RD_ST34CV RD_ST34CV RD_ST34CV 1.29
RD_ST59TS RD_ST59TS RD_ST59TS 2.56
M_ST24SA M_ST24SA M_ST24SA 3.39
RD_ST24SA RD_ST24SA RD_ST24SA 1.66
RD_ST49CV RD_ST49CV RD_ST49CV 2.54
M_ST40CV M_ST40CV M_ST40CV 6.23
RD_ST49TS RD_ST49TS RD_ST49TS 2.11
M_ST11SV M_ST11SV M_ST11SV 4.45
M_ST43TS M_ST43TS M_ST43TS 1.73
M_ST49SA M_ST49SA M_ST49SA 2.42
RD_ST56TA RD_ST56TA RD_ST56TA 3.03
M_ST15SA M_ST15SA M_ST15SA 1.69
M_ST58CV M_ST58CV M_ST58CV 5.54
M_ST60CV M_ST60CV M_ST60CV 2.44 

ptestl <- predict(bConvml,TADPOLE_Conv_TEST,type="lp")
boxplot(ptestl~TADPOLE_Conv_TEST$status)

ptestr <- predict(bConvml,TADPOLE_Conv_TEST,type="risk")
eventCases <- subset(TADPOLE_Conv_TEST,status==1)
plot(1.0/ptestr[rownames(eventCases)]~eventCases$TimeToEvent)

pander::pander(cor.test(eventCases$TimeToEvent,1.0/ptestr[rownames(eventCases)],method="spearman"))
Spearman’s rank correlation rho: eventCases$TimeToEvent and 1/ptestr[rownames(eventCases)]
Test statistic P value Alternative hypothesis rho
28076 0.0208 * two.sided 0.293 



perdsurv <- cbind(TADPOLE_Conv_TEST$TimeToEvent,
                  TADPOLE_Conv_TEST$status,
                  ptestl,
                  ptestr)
prSurv <- predictionStats_survival(perdsurv,"MCI to  AD Conversion")

pander::pander(prSurv$CIRisk)
median lower upper
0.846 0.8 0.887 
pander::pander(prSurv$CILp)
median lower upper
0.892 0.844 0.933 
pander::pander(prSurv$spearmanCI)
50% 2.5% 97.5%
0.291 0.0289 0.519 

prBin <- predictionStats_binary(cbind(TADPOLE_Conv_TEST$status,ptestl),"MCI to  AD Conversion")

pander::pander(prBin$aucs)
est lower upper
0.892 0.847 0.937 
pander::pander(prBin$CM.analysis$tab)
  Outcome + Outcome - Total
Test + 55 37 92
Test - 7 86 93
Total 62 123 185 

par(op)

2.1.2 The formula network

cmax <- apply(bConvml$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bConvml$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="MCI to Dementia Conversion")

par(op)

2.1.3 MCI to Dementia table


clusterFeatures <- fc$names

tableMCI_to_Dem <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "HR",
                                     "upper",
                                     "full.AUC",
                                     "Delta.AUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_to_Dem$Cluster <- nugget[rownames(tableMCI_to_Dem)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_to_Dem$Description <- description[rownames(tableMCI_to_Dem)]
pander::pander(tableMCI_to_Dem)
  Estimate lower HR upper full.AUC Delta.AUC z.IDI Frequency Cluster Description
ADAS11 3.74e-02 1.04e+00 1.04e+00 1.04e+00 0.785 0.003458 4.40 1.00 1 NA
ADAS13 8.60e-03 1.01e+00 1.01e+00 1.01e+00 0.750 0.024457 4.89 1.00 2 NA
ABETA -2.84e-04 1.00e+00 1.00e+00 1.00e+00 0.784 0.009811 4.32 1.00 3 NA
RAVLT_immediate -2.23e-02 9.78e-01 9.78e-01 9.78e-01 0.784 0.034439 6.29 1.00 3 NA
RAVLT_perc_forgetting 6.87e-04 1.00e+00 1.00e+00 1.00e+00 0.784 0.014608 3.45 1.00 1 NA
APOE4 4.07e-01 1.50e+00 1.50e+00 1.50e+00 0.776 0.004041 3.70 1.00 2 NA
RD_ST26TA 1.48e+00 4.38e+00 4.38e+00 4.38e+00 0.766 -0.002830 3.14 1.00 1 Cortical Thickness Average of LeftFusiform
M_ST56SA -4.59e+00 1.02e-02 1.02e-02 1.02e-02 0.780 0.011025 3.46 1.00 1 Surface Area of LeftSuperiorFrontal
FAQ 5.98e-02 1.06e+00 1.06e+00 1.06e+00 0.786 0.017355 4.31 1.00 3 NA
PTAU 6.38e-04 1.00e+00 1.00e+00 1.00e+00 0.769 -0.002717 3.45 0.95 4 NA
M_ST24CV -1.28e+01 2.65e-06 2.65e-06 2.65e-06 0.765 0.005356 2.84 0.95 3 Volume (Cortical Parcellation) of LeftEntorhinal
Entorhinal -4.39e+00 1.24e-02 1.24e-02 1.24e-02 0.745 0.032609 3.74 0.90 2 NA
TAU 1.78e-03 1.00e+00 1.00e+00 1.00e+00 0.755 0.030564 5.11 0.85 4 NA
M_ST56CV -7.12e+00 8.08e-04 8.08e-04 8.08e-04 0.780 0.024457 3.94 0.80 4 Volume (Cortical Parcellation) of LeftSuperiorFrontal
MMSE -6.19e-02 9.40e-01 9.40e-01 9.40e-01 0.785 -0.000989 3.39 0.80 1 NA
M_ST40SA -1.32e-10 1.00e+00 1.00e+00 1.00e+00 0.749 0.018003 3.43 0.80 3 Surface Area of LeftMiddleTemporal
M_ST29SV -1.19e+01 6.99e-06 6.99e-06 6.99e-06 0.780 0.002717 3.56 0.75 4 Volume (WM Parcellation) of LeftHippocampus
M_ST12SV -1.37e+01 1.08e-06 1.08e-06 1.08e-06 0.737 0.036408 4.31 0.75 4 Volume (WM Parcellation) of LeftAmygdala
RD_ST55TS -2.69e+00 6.82e-02 6.82e-02 6.82e-02 0.755 0.019866 3.03 0.60 4 Cortical Thickness Standard Deviation of LeftRostralMiddleFrontal
RD_ST44TS -1.53e+00 2.16e-01 2.16e-01 2.16e-01 0.779 0.007418 3.60 0.50 4 Cortical Thickness Standard Deviation of LeftParahippocampal
RD_ST49SA -3.57e-01 7.00e-01 7.00e-01 7.00e-01 0.784 0.021404 2.85 0.45 1 Surface Area of LeftPostcentral
RD_ST46SA -9.12e-01 4.02e-01 4.02e-01 4.02e-01 0.780 0.024457 3.08 0.35 4 Surface Area of LeftParsOrbitalis
M_ST39SA -1.57e+00 2.07e-01 2.07e-01 2.07e-01 0.796 0.038043 4.49 0.25 4 Surface Area of LeftMedialOrbitofrontal
RD_ST47TA -1.02e+00 3.61e-01 3.61e-01 3.61e-01 0.780 0.005435 4.58 0.25 4 Cortical Thickness Average of LeftParsTriangularis

2.1.4 Saving the enviroment

save.image("./TADPOLE_BSWIMS_Results.RData")